home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / psstr108.zip / PASSTR.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-10  |  23KB  |  1,108 lines
  1. {
  2.  
  3. Pascal String and Variable Procedures
  4.  
  5. Rev. 1.08
  6.  
  7. (c) Copyright 1993, Michael Gallias
  8.  
  9. Target: Real, Windows
  10.  
  11. Comment: Some procedures do work under Protected Mode, but not all of them.
  12.  
  13. To compile this with Turbo Pascal 6, simply remove the 'Const'
  14. from the procedure defintions, e.g.
  15.  
  16. Procedure MyProc(Const MyVar:MyType);
  17.  
  18. becomes
  19.  
  20. Procedure MyProc(MyVar:MyType);
  21.  
  22. }
  23.  
  24. {$V-} {$B-}
  25.  
  26. Unit PasStr;
  27.  
  28. Interface
  29.  
  30. {$IFNDEF WINDOWS}
  31.  
  32. Uses CRT,Dos;
  33.  
  34. Const
  35.   MaxXYSaves        =    5;                  {Max Number of Cursor Saves}
  36.  
  37. Type
  38.   XYType            = (CursorX,CursorY);
  39.   XYPosData         = Array[1..MaxXYSaves] of
  40.                         Array [XYType] of Byte;
  41.   KeyBufferFunction = (Clear,Save,Restore);
  42.  
  43. {$ENDIF}
  44.  
  45. Const
  46.   LeftText          =    0;
  47.   CentreText        =    1;
  48.   CenterText        =    1;
  49.   RightText         =    2;
  50.   OutSideText       =    3;
  51.  
  52. Type
  53.   TextFormats       = LeftText..RightText;
  54.   JustifyFormats    = LeftText..OutSideText;
  55.   CharSet           = Set Of Char;
  56.  
  57. {$IFDEF WINDOWS}
  58.  
  59. Procedure FSplit        (Path:String; Var Dir, Name, Ext:String);
  60.  
  61. {$ELSE}
  62.  
  63. Procedure SaveCursorSize(Var Data:Word);
  64. Procedure RestCursorSize(Data:Word);
  65. Procedure SaveXYPos     (Var Position:XYPosData);
  66. Procedure RestXYPos     (Var Position:XYPosData);
  67. Procedure CursorSize    (UpLim,DownLim:Byte);
  68.  
  69. Procedure PushCursorSize;
  70. Procedure PopCursorSize;
  71. Procedure PushXYPos;
  72. Procedure PopXYPos;
  73. Procedure PushTextColor;
  74. Procedure PopTextColor;
  75.  
  76. Procedure KeyBuffer     (Option:KeyBufferFunction);
  77.  
  78. {$IFDEF MSDOS}
  79.  
  80. Function  MemoryCount   (P:Pointer):LongInt;
  81. Procedure GetLowestOfs  (P:Pointer; Var S,O:Word);
  82. Procedure AdjustPtr     (Var P:Pointer; Amount:LongInt);
  83.  
  84. {$ENDIF}
  85.  
  86. {$ENDIF}
  87.  
  88. Procedure SpacesToZeros (StIn:String; Var StOut:String);
  89. Procedure RemoveLeading (StIn:String; Var StOut:String;
  90.                          Const RemoveSet:CharSet);
  91. Function  PosFrom       (SubS:String; StIn:String; FarIn:Byte):Byte;
  92. Function  RevPosFrom    (SubS:String; StIn:String; FarIn:Byte):Byte;
  93. Procedure UpperCase     (StIn:String; Var StOut:String);
  94. Procedure LowerCase     (StIn:String; Var StOut:String);
  95. Procedure CapWords      (StIn:String; Var StOut:String);
  96. Procedure PadVar        (StIn:String; Var StOut:String; Count:Byte);
  97. Procedure PadVarWith    (StIn:String; Var StOut:String; Count:Byte;
  98.                          WithMe:Char);
  99. Procedure PadFileName   (StIn:String; Var StOut:String);
  100. Procedure FormatVar     (StIn:String; Var StOut:String;
  101.                          Size:Byte; Format:TextFormats);
  102. Procedure UnPadVar      (StIn:String; Var StOut:String);
  103. Procedure UnPadVarRight (StIn:String; Var StOut:String);
  104. Procedure UnPadVarLeft  (StIn:String; Var StOut:String);
  105. Procedure RightJustify  (StIn:String; Var StOut:String;
  106.                          Margin:Byte; JType:JustifyFormats);
  107.  
  108. Procedure ByteToHex     (Decimal:Byte; Var Hex:String);
  109. Procedure WordToHex     (Decimal:Word; Var Hex:String);
  110. Procedure LongIntToHex  (Decimal:LongInt; Var Hex:String);
  111.  
  112. Function  HexDigitValue (HexDigit:Char):Byte;
  113. Procedure HexToByte     (Hex:String; Var Decimal:Byte; Var Code:Integer);
  114. Procedure HexToWord     (Hex:String; Var Decimal:Word; Var Code:Integer);
  115. Procedure HexToLongInt  (Hex:String; Var Decimal:LongInt; Var Code:Integer);
  116.  
  117. Function  Min           (I, J:LongInt):LongInt;
  118. Function  Max           (I, J:LongInt):LongInt;
  119.  
  120. Function  AdjustMeter   (StartMeter1,EndMeter1,ValueMeter1,
  121.                          StartMeter2,EndMeter2:LongInt):LongInt;
  122.  
  123. Procedure SwapBytes     (Var A,B:Byte);
  124. Procedure SwapIntegers  (Var A,B:Integer);
  125. Procedure SwapWords     (Var A,B:Word);
  126. Procedure SwapLongInts  (Var A,B:LongInt);
  127. Procedure SwapReals     (Var A,B:Real);
  128. Procedure SwapStrings   (Var A,B:String);
  129.  
  130. {$IFOPT N+}
  131.  
  132. Procedure SwapSingles   (Var A,B:Single);
  133. Procedure SwapDoubles   (Var A,B:Double);
  134. Procedure SwapExtendeds (Var A,B:Extended);
  135. Procedure SwapComps     (Var A,B:Comp);
  136.  
  137. {$ENDIF}
  138.  
  139. Implementation
  140.  
  141. {$IFDEF WINDOWS}
  142.  
  143. Procedure FSplit(Path:String; Var Dir, Name, Ext:String);
  144.  
  145. Var
  146.   LastSlash  :Byte;
  147.  
  148. Begin
  149.   LastSlash:=RevPosFrom('\',Path,Length(Path));
  150.   If LastSlash=0 Then
  151.   Begin
  152.     LastSlash:=RevPosFrom(':',Path,Length(Path));
  153.     If LastSlash>0 Then
  154.     Begin                               {Found a Drive with Default Path}
  155.       Dir:=Copy(Path,1,LastSlash);
  156.       Delete(Path,1,LastSlash);
  157.       LastSlash:=0;
  158.     End
  159.     Else                                {No Drive, No Path}
  160.       Dir:='';
  161.   End
  162.   Else
  163.   Begin                                 {A Path Found}
  164.     Dir:=Copy(Path,1,LastSlash);
  165.     Delete(Path,1,LastSlash);           {Delete Directory}
  166.   End;
  167.  
  168.   LastSlash:=Pos('.',Path);
  169.   If LastSlash>0 Then
  170.   Begin
  171.     Name:=Copy(Path,1,LastSlash-1);
  172.     Ext:=Copy(Path,LastSlash,Length(Path)-(LastSlash-1));
  173.   End
  174.   Else
  175.   Begin
  176.     Name:=Path;
  177.     Ext:='';
  178.   End;
  179.   If Length(Name)>8 Then Name:=Copy(Name,1,8);
  180.   If Length(Ext)>4 Then Ext:=Copy(Ext,1,4);
  181. End;
  182.  
  183. {$ELSE}
  184.  
  185. Var
  186.   PushPopCursorSize:Array[1..MaxXYSaves] of Word;
  187.   PushPopTextColor :Array[1..MaxXYSaves] of Word;
  188.   PushPopCursorPos :XYPosData;
  189.  
  190. Procedure SaveCursorSize(Var Data:Word); Assembler;
  191. Asm
  192.   mov  ah,3
  193.   int  10h
  194.   les  di,Data
  195.   mov  es:[di],cx
  196. End;
  197.  
  198. Procedure RestCursorSize(Data:Word); Assembler;
  199. Asm
  200.   mov  ah,1
  201.   mov  cx,Data
  202.   int  10h
  203. End;
  204.  
  205. Procedure SaveXYPos(Var Position:XYPosData);
  206. {This saves the current cursor position and can store up to the last five}
  207. {cursor positions}
  208. {Number 'MaxXYSaves' is the lastest save}
  209.  
  210. Var
  211.   X:Byte;   {Loop}
  212.  
  213. Begin
  214.   For X:=1 to MaxXYSaves-1 do                    {Shift Cursor Saves up}
  215.   Begin
  216.       Position[X,CursorX]:=Position[X+1,CursorX];
  217.       Position[X,CursorY]:=Position[X+1,CursorY];
  218.   End;   {For X Loop}
  219.   Position[5,CursorX]:=WhereX;      {Insert New Cursor Save Position}
  220.   Position[5,CursorY]:=WhereY;
  221. End;  {SaveXYPos}
  222.  
  223. Procedure RestXYPos(Var Position:XYPosData);
  224. {This will restore up to five previously saved cursor positions}
  225. {Number 'MaxXYSaves' is the position to be restored}
  226.  
  227. Var
  228.   X:Byte;       {Loop}
  229.  
  230. Begin
  231.   GotoXY(Position[MaxXYSaves,CursorX],Position[MaxXYSaves,CursorY]); {Goto Old Position}
  232.   For X:=MaxXYSaves downto 2 do    {Shift up the cursor positions for the next restore}
  233.   Begin
  234.       Position[X,CursorX]:=Position[X-1,CursorX];
  235.       Position[X,CursorY]:=Position[X-1,CursorY];
  236.   End;  {For X Loop}
  237. End;  {RestXYPos}
  238.  
  239. Procedure CursorSize(UpLim,DownLim:Byte); Assembler;
  240. {Set the cursor size.  Send $20,$20 for no cursor}
  241. Asm
  242.   mov  ah,1
  243.   mov  ch,UpLim
  244.   mov  cl,DownLim
  245.   int  10h
  246. End;
  247.  
  248. Procedure PushCursorSize;
  249.  
  250. Var
  251.   X:Word;
  252.  
  253. Begin
  254.   For X:=1 to MaxXYSaves-1 do
  255.     PushPopCursorSize[X]:=PushPopCursorSize[X+1];
  256.  
  257.   Asm
  258.     mov  ah,3
  259.     int  10h
  260.     mov  X,cx
  261.   End;
  262.  
  263.   PushPopCursorSize[MaxXYSaves]:=X;
  264. End;
  265.  
  266. Procedure PopCursorSize;
  267.  
  268. Var
  269.   X:Word;
  270.  
  271. Begin
  272.   X:=PushPopCursorSize[MaxXYSaves];
  273.  
  274.   Asm
  275.     mov  ah,1
  276.     mov  cx,X
  277.     int  10h
  278.   End;
  279.  
  280.   For X:=MaxXYSaves DownTo 2 do
  281.     PushPopCursorSize[X]:=PushPopCursorSize[X-1];
  282. End;
  283.  
  284. Procedure PushXYPos;
  285.  
  286. Var
  287.   X:Byte;
  288.  
  289. Begin
  290.   For X:=1 to MaxXYSaves-1 do
  291.     PushPopCursorPos[X]:=PushPopCursorPos[X+1];
  292.  
  293.   PushPopCursorPos[MaxXYSaves,CursorX]:=WhereX;
  294.   PushPopCursorPos[MaxXYSaves,CursorY]:=WhereY;
  295. End;
  296.  
  297. Procedure PopXYPos;
  298.  
  299. Var
  300.   X:Byte;
  301.  
  302. Begin
  303.   GotoXY(PushPopCursorPos[MaxXYSaves,CursorX],
  304.          PushPopCursorPos[MaxXYSaves,CursorY]);
  305.  
  306.   For X:=MaxXYSaves DownTo 2 do
  307.     PushPopCursorPos[X]:=PushPopCursorPos[X-1];
  308. End;
  309.  
  310. Procedure PushTextColor;
  311.  
  312. Var
  313.   X:Byte;
  314.  
  315. Begin
  316.   For X:=1 to MaxXYSaves-1 do
  317.     PushPopTextColor[X]:=PushPopTextColor[X+1];
  318.  
  319.   PushPopTextColor[MaxXYSaves]:=TextAttr;
  320. End;
  321.  
  322. Procedure PopTextColor;
  323.  
  324. Var
  325.   X:Word;
  326.  
  327. Begin
  328.   TextAttr:=PushPopTextColor[MaxXYSaves];
  329.  
  330.   For X:=MaxXYSaves DownTo 2 do
  331.     PushPopTextColor[X]:=PushPopTextColor[X-1];
  332. End;
  333.  
  334. Procedure KeyBuffer(Option:KeyBufferFunction);
  335.  
  336. Type
  337.   KeyBufType=Record
  338.                Head:Word;
  339.